home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / DIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-10  |  2.4 KB  |  121 lines
  1. program Dir2;
  2.  
  3. {This program displays the default directory plus the free space
  4.  on both disks. It works only on MS-DOS (or PC-DOS) version 2. It
  5.  assumes a screen 80 columns wide and at least 24 lines deep.   }
  6.  
  7. Type
  8.   regpack = record
  9.               case integer of
  10.                 1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  11.                 2: (al,ah,bl,bh,c,ch,dl,dh         : byte)
  12.             end;
  13.  
  14.   dtaarray =    array[0..42] of byte;
  15.   dtacharray =  array[0..42] of char;
  16.  
  17. const
  18.    getdta =       $1a;
  19.    get1stdir =    $4e;
  20.    getnextdir =   $4f;
  21.    getfreespace = $36;
  22.  
  23. var
  24.    filestr:        string[14];
  25.    dta:            dtaarray;
  26.    cdta:           dtacharray absolute dta;
  27.  
  28. procedure DTAcall;
  29.  
  30. var
  31.   regs:       regpack;
  32.  
  33. begin
  34.   with regs do begin
  35.     ah := getdta;
  36.     ds := seg(dta);
  37.     dx := ofs(dta);
  38.     MsDos(regs)
  39.   end
  40. end; {DTAcall}
  41.  
  42. procedure Firstcall(var errflag:    byte);
  43.  
  44. var
  45.   regs:       regpack;
  46.  
  47. begin
  48.   with regs do begin
  49.     ah := get1stdir;
  50.     cx := 0;
  51.     ds := seg(filestr);
  52.     dx := ofs(filestr[1]);
  53.     MsDos(regs);
  54.     if (flags and 1) = 1 then errflag:= lo(ax)
  55.       else errflag:= 0
  56.   end
  57. end; {firstcall}
  58.  
  59. procedure Nextcall(var errflag:    byte);
  60.  
  61. var
  62.   regs:       regpack;
  63.  
  64. begin
  65.   regs.ah := getnextdir;
  66.   MsDos(regs);
  67.   if (regs.flags and 1) = 1 then errflag:= regs.al
  68.   else errflag:= 0
  69. end; {nextcall}
  70.  
  71. Function Freespace(drive: char):real;
  72.  
  73. var
  74.   regs:       regpack;
  75.   fr:          real;
  76.  
  77. begin
  78.   with regs do begin
  79.     dx := ord(drive) - 64;
  80.     ah := getfreespace;
  81.     MsDos(regs);                       { call function }
  82.     fr := bx;
  83.     if ax > 0 then Freespace  := fr * ax * cx
  84.     else freespace:= 0
  85.   end
  86. end; {freespace}
  87.  
  88. Procedure loaddir;
  89.  
  90. var
  91.    i, j:   integer;
  92.    err:    byte;
  93.  
  94. begin
  95.   clrscr;
  96.   gotoxy(35,2);
  97.   write('DIRECTORY');
  98.   filestr:= '*.*';
  99.   fillchar(dta, 42, 0);
  100.   DTAcall;
  101.   Firstcall(err);
  102.   j:= 0;
  103.   repeat
  104.     gotoxy((j mod 3)*28, j div 3 + 4);
  105.     i:= 30;
  106.     while dta[i] <> 0 do begin
  107.       write(cdta[i]);
  108.       i:= i + 1
  109.     end;
  110.     for i:= i to 42 do write(' ');
  111.     write(dta[26] + 256 * dta[27] + 65536. * dta[28]:5:0, ' bytes');
  112.     j:= j + 1;
  113.     Nextcall(err)
  114.   until err <> 0;
  115.   gotoxy(1,23);
  116.   write('Drive C: ', freespace('C'):6:0, ' bytes free.');
  117. end; {loaddir}
  118.  
  119. begin
  120.   loaddir
  121. end.